home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops source / PPC source / pBase < prev    next >
Text File  |  1998-06-08  |  4KB  |  171 lines
  1. (*
  2.  
  3. This file is derived from Base.  It's a "p" file - it contains any
  4. defns from the original Base that:
  5.  
  6. 1. are needed for the PPC image as generated on the 68k, and
  7.  
  8. 2. have to be compiled AFTER we start compiling PPC code - i.e. after
  9.     CROSS at the beginning of Setup, which crosses us over into PPC-land.
  10.     
  11. So, here we only have to include words that compile to PPC code, and
  12. never get executed at compile time.
  13.  
  14. Thus we only include words which come from Base and haven't been
  15. included in qBase, as well as any from qBase that get executed at
  16. both compile and run time.  There aren't very many - I'll try to keep
  17. it as short as possible and just add extra ones as we need them.
  18.  
  19. *)
  20.  
  21.  
  22. : SAVE-INPUT
  23.     src-start  src-len  >in @  source-id  4  ;
  24.  
  25. : RESTORE-INPUT
  26.     dup 4 <>  IF  true  EXIT  THEN
  27.     drop
  28.     -> source-id  >in !  -> src-len  -> src-start  false  ;
  29.  
  30.  
  31. ¥        =========================
  32.  
  33.  
  34. ¥ U.H prints an unsigned number in hex.  (.H is already defined, in pnuc2)
  35.  
  36. : U.H    base >r  hex  u.  r> -> base  ;
  37.  
  38.  
  39. ¥ create BUF255  256 allot        ¥ buffer for string operations
  40. ¥ - moved to setup before create and allot are redefined
  41.  
  42.  
  43. : >STR255        ¥ ( addr len addr -- addr )
  44.                 ¥ Converts a string to a Str255 at addr
  45.     dup >r  place  r>  ;
  46.  
  47. : STR255    ¥ ( -- ^buf255 )
  48.     buf255 >str255  ;
  49.  
  50.  
  51.  
  52. ¥                    ==================
  53.  
  54. ¥ Once we're compiling PPC code, we have to keep the code and data areas
  55. ¥  distinct.  DP points to the data area, and CDP points to the code area.
  56.  
  57. (* now in pnuc3
  58. : code,        CDP !   4 ++> CDP  ;
  59. : codeW,    CDP w!  2 ++> CDP  ;
  60. : codeC,    CDP c!  1 ++> CDP  ;
  61.  
  62. : codeN,  ( addr len -- )
  63.     tuck
  64.     CDP swap cmove
  65.     ++> CDP
  66. ;
  67.  
  68.  
  69. : RESERVE        ¥ ( len -- )  Allot and clear.
  70.     here over erase allot  ;
  71.  
  72. : CODE_RESERVE
  73.     CDP over erase  ++> CDP  ;
  74.  
  75. *)
  76.  
  77. ¥                    ==================
  78.  
  79.  
  80. syscall    OpenResFile
  81. syscall    CloseResFile
  82.  
  83. ¥ We can't leave OpenResFile or CloseResFile in the dic as syscalls, since
  84. ¥  they have another meaning in Mops.  So we have to rename them:
  85.  
  86. & Z  ' OpenResFile >namex 1+ c!        ¥ Make it ZpenResFile
  87. & Z  ' CloseResFile >namex 1+ c!        ¥ Make it ZloseResFile
  88.  
  89. 0  value    ResRefNum
  90.  
  91. : OpenResFile        ¥ ( addr len -- )  Opens named resource file
  92.     str255  ZpenResFile
  93.     dup -> ResRefNum
  94.     -1 = abort" resource file open failed"  ;
  95.  
  96. : CloseResFile        ¥ ( -- )
  97.     ResRefnum  ZloseResFile  ;
  98.  
  99.  
  100. : OPENMR            ¥ Opens the Mops system resource file if necessary.
  101.     MRopen?  ?EXIT                    ¥ Do nothing if already open
  102.     instld?  ?EXIT                    ¥ or if this is an installed application
  103.     " mops.rsrc" OpenResFile
  104.     true -> MRopen?  ;
  105.  
  106.  
  107. syscall GetResource
  108.  
  109. : GETRES    ¥ ( type resID -- handle )
  110.     GetResource  ;
  111.  
  112.  
  113. syscall GetString
  114.  
  115. : GETSTRING        ¥ ( resID -- addr len )  Get the string with resource ID
  116.     openMR
  117.     GetString
  118.     dup
  119.     IF    @ count  ( addr len )
  120.         pad swap  ( addr pad len )  ¥ i.e. ( src dest len)
  121.         dup >r    ¥ save len
  122.         cmove
  123.         pad r>  ( addr len )
  124.     ELSE
  125.         0
  126.     THEN  ;
  127.  
  128.  
  129. :f TSTR            ¥ ( id# -- )  Prints string with given resID.
  130.     getString type  ;f
  131.  
  132.  
  133.  
  134. : TO_BE_WRITTEN        79 die  ;
  135.  
  136.  
  137.  
  138. ¥        =================== MARKER =====================
  139.  
  140. (*    On the PPC we don't support FORGET any more, since it's too tricky
  141.     with saparate code and data.  So we'll deprecate FORGET, and
  142.     encourage use of the standard word MARKER.
  143.  
  144.     For MARKER, we don't use <builds...does> as on the 68k, since
  145.     there's no need to put the marker info in the data area, 'cause
  146.     it's only used during development.  A marker just becomes a
  147.     defn with a special handler code, and we put the associated
  148.     info straight after the header in the code area.
  149.     
  150.     We can't execute the marker in the handler, since at that stage
  151.     we're probably in the execution buffer so resetting CDP wouldn't
  152.     be very sensible.  So we just compile a call to (mrk) which does
  153.     the work.  (mrk) is in zBase, along with the other related words.
  154.     We just need MARKER here in pBase, since when we natively load
  155.     the first file (zBase) we need MARKER to already exist, so that
  156.     zBase gets a proper file mark.
  157. *)
  158.  
  159. : MARKER
  160.     CDP
  161.     ppc_header
  162.     $ BC410000 code,                ¥ marker_h handler code, and alignment
  163.                                     ¥ Note - we'll indicate a file mark
  164.                                     ¥  by putting something nonzero in these
  165.                                     ¥  pad bytes
  166.     ( orig-CDP )    displCode,
  167.     DP                displCode,
  168. ;        ppc_only
  169.  
  170. endload
  171.